﻿{-# OPTIONS_GHC -XRecordWildCards -XTransformListComp -XNamedFieldPuns #-}
module XI.Directory.Todo where
import XI.Directory.Types
import Data.Maybe
import Data.List
-- import qualified Data.Map as Map
import Control.Monad.Error
import Data.Ord
import Control.Arrow
import GHC.Exts(the)
import Data.Function

todo :: Configuration -> Either String [XIObj]
todo (scs, xos) = 
    if (nubBy cmp vals) == vals 
    then Right vals 
    else Left $ "Error! There are different objects with the same ID:\n" ++
            concatMap (\a->getId (head a) ++ " -> " ++ (show a) ++ "\n") 
                    (nub $ filter ((>1) . length) $ map (flip filter vals . cmp) vals)
    where
        cmp = (==) `on` getId
        vals = (\(a,b) -> groupSc a ++ b) $ partition isSc $ sort $ nub $ concatMap (todo_sc xos) scs ++ xos
        groupSc scs' = [Sc { 
                sc_name = the name,
                sc_description = the description,
                sc_ids = sort $ nub $ concat ids 
            } | (name, description, ids) <- map (\(Sc {..}) -> (sc_name, sc_description, sc_ids)) scs', 
                then group by (name, description)]

do_chains :: [XIObj] -> [Chain] -> [XIObj]
do_chains xos = sort . nub . concatMap (todo_ch xos)
    
todo_sc :: [XIObj] -> Scenario -> [XIObj]
todo_sc xos sc = map (\nm -> Sc {
        sc_name = nm,
        sc_description = scenario_description sc,
        sc_ids = sort $ nub $ map getId chained_objects
    }) (maybeToList $ scenario_name sc) ++ chained_objects
    where
        chained_objects = do_chains xos $ scenario_chains sc

def_cc :: (XISystem, String) -> XIObj
def_cc (sys, name) = CC {cc_system = sys, cc_name = name, cc_description = "", cc_param = def_CCParam, cc_param_map = Nothing}
        
todo_ch :: [XIObj] -> Chain -> [XIObj]
todo_ch xos (Chain {..}) = 
    [cc | cc <- getById (def_cc $ (s_sys &&& s_cc) chain_sender) xos, s_cc chain_sender /= "-"] ++ 
    [getByIdDef' SAgg {	
            sender = s_sys chain_sender,
            sender_int = s_int chain_sender,
            sa_description = snd $ s_descriptions chain_sender,
            sender_cc =  s_cc chain_sender } | s_cc chain_sender /= "-", isSAreq at] ++ 
    [getByIdDef' RD {	
            sender = s_sys chain_sender,
            rd_description = chain_description,
            sender_int = s_int chain_sender,
            cond_receivers =  sort $ map (r_cond &&& r_sys) chain_receivers }] ++
    nub (map (\(Receiver {r_cond = _, ..}) -> getByIdDef' ID {	
                    sender = s_sys chain_sender,
                    sender_int = s_int chain_sender, 
                    receiver = r_sys,
                    id_description = r_description,
                    cond_receiver_ints = sort $ map (\(RcvInt { ri_cond, r_int, mapping })->(ri_cond, r_int, mapping)) r_ints }
            ) chain_receivers) ++
    nub (concatMap (\(Receiver {r_sys, r_ints}) -> nub $ concatMap (\(RcvInt {r_cc, r_int, r_descriptions})-> if r_cc == "-" then [] else 
            getById (def_cc (r_sys, r_cc)) xos ++
            [getByIdDef' RAgg {	
                    sender = s_sys chain_sender,
                    receiver = r_sys,
                    receiver_int = r_int,
                    ra_description = snd r_descriptions,
                    receiver_cc = r_cc }]
        ) $ r_ints) chain_receivers)
    where 
        ccs = filter isCC xos
        at = getAT ccs (s_sys chain_sender) (s_cc chain_sender)
        getByIdDef' = flip getByIdDef xos

------- ------ -----------		
getById :: XIObj -> [XIObj] -> [XIObj]
getById xo = take 1 . sortBy (comparing (negate . length . filter (=='*'). getId)) . filter (cmpId xo)
getByIdDef :: XIObj -> [XIObj] -> XIObj
getByIdDef xo = fromMaybe xo . listToMaybe . filter ((xo==) . determineBy xo) . getById xo

chains :: [XIObj] -> [Chain]
chains xs = [
        Chain { 
                chain_sender = Sender {	
                        s_sys = sender, 
                        s_cc = sender_cc,
                        s_descriptions = (get_cc_description sender sender_cc, sa_description),
                        s_int = sender_int,
                        s_cc_params = get_cc_params sender sender_cc,
                        s_params = Nothing
                    }, 
                chain_receivers = rs,
                chain_description = rd_description
            } | 
        SAgg {..} <- nub $ xs ++ [
                SAgg {	
                        sender = cc_system,
                        sender_int = si,
                        sender_cc = cc_name,
                        sa_description = ""
                    } | 
                cc@(CC {cc_system, cc_name, cc_param}) <- filter isCC xs, 
                si <- maybeToList (getSIfromCC cc), 
                not $ isSAreq $ snd cc_param
            ] ++ [
                SAgg {	
                        sender = ip_system,
                        sender_int = sender_int,
                        sender_cc = "-",
                        sa_description = ""
                    } | 
                RD {sender, sender_int} <- xs, 
                IP {ip_system} <- xs,
                sender == ip_system
            ],
        RD {cond_receivers, rd_description} <- getById' (RD {	
                sender = sender,  
                sender_int = sender_int, 
                rd_description = "",
                cond_receivers = []
            }),
        rs <- [[Receiver {  
                r_cond = cond,
                r_sys = r,
                r_description = id_description,
                r_ints = ris
            } |
            (cond, r) <- cond_receivers,
            ID {id_description, cond_receiver_ints} <- getById' ID {	
                    sender = sender,  
                    sender_int = sender_int, 
                    receiver = r,
                    id_description = "",
                    cond_receiver_ints = []
                },
            ris <- [[RcvInt { 
                    ri_cond = condi,
                    r_int = ri,
                    r_descriptions = (get_cc_description r receiver_cc, ra_description), 
                    mapping = m,
                    r_cc = receiver_cc,
                    r_cc_params = get_cc_params r receiver_cc,
                    r_params = Nothing
                } | 
                (condi, ri, m) <- cond_receiver_ints, 
                RAgg {receiver_cc, ra_description} <- getById' RAgg { 
                        sender = sender, 
                        receiver = r,
                        receiver_int = ri,
                        ra_description = "",
                        receiver_cc = ""
                    } ++ [
                        RAgg { 
                                sender = ip_system,
                                receiver = r,
                                receiver_int = ri,
                                ra_description = "",
                                receiver_cc = "-"
                            } | 
                        IP {ip_system} <- xs,
                        ip_system == r
                    ]
                ]],
            length cond_receiver_ints == length ris
    ]],
                length cond_receivers == length rs
            ]
    where
        getById' = flip getById xs
        get_cc_params sys name = join . listToMaybe . map cc_param_map $ get_cc sys name
        get_cc_description sys name = fromMaybe "" . listToMaybe . map cc_description $ get_cc sys name
        get_cc sys name = getById' $ def_cc (sys, name)
  
scenarios' :: [XIObj] -> Either String [Scenario]
scenarios' xs = todo (sc_ch, filter isCC xs) >>= return . (sc_ch ++) . (:[]) . flip (Scenario Nothing "") Nothing . chains . (xs\\)
    where
        sc_ch = filter (not . null . scenario_chains) $ 
            filter isSc xs >>= \(Sc {..})-> return $ Scenario {	
                    scenario_name = Just sc_name,
                    scenario_description = sc_description,
                    scenario_chains = chains $ filter (\xo -> isIP xo || getId xo `elem` sc_ids) xs,
                    scenario_notes = Nothing
                }
  
scenarios :: [XIObj] -> Either String Configuration
scenarios xs = do
    scs <- scenarios' xss
    todo (scs, filter isCC xss) >>= return . (,) scs . filter (null . filter (null . sc_ids) . 
            filter isSc . (:[]))	. map (fsc scs) . (xss \\) . filter (not . isCC)
    where 
        xss = sort $ nub xs 
        fsc scs x
            | isSc x = x {
                    sc_ids = filter (`elem` (map getId xss)) $ (sc_ids x) \\ (
                            map getId $ concatMap (todo_ch xss) $ concatMap scenario_chains $ take 1 $ 
                                    filter ((== Just (sc_name x)) . scenario_name) scs
                        )
                }
            | otherwise = x
